      ***************************************************************
       IDENTIFICATION DIVISION.
      ***************************************************************
       PROGRAM-ID.    P231F01.
       AUTHOR.        B.W. MCNULTY.
       DATE-WRITTEN.  APRIL 1, 1994.
      ***************************************************************
      *                                                             *
      *   PROGRAM:  P231F01 - FDAT - DISTRIBUTION MENU LIST         *
      *                                                             *
      *   SYSTEM:   FDAT - TABLE MAINTENANCE SYSTEM                 *
      *                                                             *
      *   FUNCTION: THIS PROGRAM IS THE DISTRIBUTION MENU LIST FOR  *
      *             ALL DISTRIBUTION ID'S THAT THE LOGON ID HAS     *
      *             SECURITY ACCESS TO.                             *
      *                                                             *
      *   LANGUAGE: COBOL II / SQL / CICS                           *
      *                                                             *
      *   ENTRY:    CICS TRANSACTION ID "FD01" THRU "FDAT"          *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   DATABASE TABLES AND FILES:                                *
      *                                                             *
      *       T231ACS  - SECURITY ACCESS TABLE                      *
      *       T231SEC  - SECURITY DISTIRBUTION TABLE                *
      *       T231DIST - DISTRIBUTION TABLE                         *
      *       T231DSHD - DISTRIBUTION HEADER TABLE                  *
      *       T231DSLN - DISTRIBUTION LINE TABLE                    *
      *       T231DSBK - DISTRIBUTION BOOK TABLE                    *
      *       T231BOOK - BOOK TABLE                                 *
      *       T231RPT  - REPORT TABLE                               *
      *       T231LINE - LINE TABLE                                 *
      *       T231COL  - COLUMN TABLE                               *
      *       T231ORG  - ORGANIZATION TABLE                         *
      *       T231RGN  - REGION TABLE                               *
      *       T231PRIM - PRIME TABLE                                *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   CALLED SUBROUTINES:                                       *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   MODIFICATIONS:                                            *
      *                                                             *
      *   DATE      PROGRAMMER     DESCRIPTION                      *
      *   --------  -------------  -------------------------------  *
      *   04/01/94  B.W. MCNULTY   ORIGINAL VERSION.                *
      *                                                             *
      ***************************************************************

       ENVIRONMENT DIVISION.

           EJECT
       DATA DIVISION.

       WORKING-STORAGE SECTION.

       01  FILLER                      PIC X(35) VALUE
           'WORKING STORAGE BEGINS HERE ======>'.
      **===========================================================**
      **   PROGRAM ID CONSTANTS                                    **
      **===========================================================**
       01  W0000-PROGRAM-INFO.
           05  PROGRAM-NAME            PIC  X(08)  VALUE 'P231F01'.
           05  MAP-NAME                PIC  X(08)  VALUE 'M231F01'.
           05  SET-NAME                PIC  X(08)  VALUE 'M231F01'.
           05  MAP-NAME-1              PIC  X(08)  VALUE 'M231F01'.
           05  MAP-NAME-A              PIC  X(08)  VALUE 'M231F1A'.
           05  TXN-ID                  PIC  X(04)  VALUE 'FD01'.
           05  MAP-DATA                PIC  X(1920)  VALUE SPACES.

           05  ERROR-FLAG              PIC  X(1)   VALUE 'N'.
               88  NO-ERRORS                       VALUE 'N'.
               88  ERRORS                          VALUE 'Y'.

           05  M-MSG-24I               PIC  X(80)  VALUE SPACES.

      **===========================================================**
      **   MISCELLANEOUS WORK FIELDS                               **
      **===========================================================**
           EJECT
       01  W0001-MISCELLANEOUS-FIELDS.
           05  W0001-PGM-XCTL-NO       PIC  X(08)  VALUE SPACES.
           05  W0001-TXN-ID            PIC  X(04)  VALUE SPACES.
           05  W0001-XCTL-PGM-ID       PIC  X(08)  VALUE 'P231F01'.
           05  W0001-LINK-PGM-ID       PIC  X(08)  VALUE 'P231F01'.
           05  W0001-LINK-CA           PIC  X(999) VALUE SPACES.
           05  W0001-SCREEN-LINE-LIMIT PIC S9(09)  COMP-3 VALUE +13.
           05  W0001-COPY-CTR          PIC S9(09)  COMP-3 VALUE +0.

           05  W0001-ABSTIME           PIC S9(16)  COMP.
           05  W0001-HHCMMCSS.
               10  W0001-HR            PIC  X(02).
               10  W0001-C1            PIC  X(01).
               10  W0001-MIN           PIC  X(02).
               10  W0001-C2            PIC  X(01).
               10  W0001-SEC           PIC  X(02).
           05  W0001-MMSDDSYY.
               10  W0001-MON           PIC  X(02).
               10  W0001-S1            PIC  X(01).
               10  W0001-DAY           PIC  X(02).
               10  W0001-S1            PIC  X(01).
               10  W0001-YEAR          PIC  X(02).
           05  W0001-YYYY.
               10  W0001-YY            PIC  X(04).

           05  W0001-DB2-ZERO-DATE     PIC  X(10) VALUE '01/01/0001'.
           05  W0001-DB2-MAX-DATE      PIC  X(10) VALUE '12/31/9999'.
           05  W0001-DB2-DATE.
               10  W0001-DB2-MM        PIC  X(02)  VALUE '01'.
               10  W0001-DB2-DASH1     PIC  X(01)  VALUE '/'.
               10  W0001-DB2-DD        PIC  X(02)  VALUE '01'.
               10  W0001-DB2-DASH2     PIC  X(01)  VALUE '/'.
               10  W0001-DB2-CC        PIC  X(02)  VALUE '19'.
               10  W0001-DB2-YY        PIC  X(02)  VALUE '99'.
           05  W0001-MMYY-DATE.
               10  W0001-MM            PIC  X(02).
               10  W0001-YY            PIC  X(02).

           05  W0001-X                 PIC S9(09)  COMP.
           05  W0001-IX                PIC S9(09)  COMP.
           05  W0001-IX2               PIC S9(09)  COMP.

           05  W0001-PD-X                      PIC X(02).
           05  W0001-PD  REDEFINES W0001-PD-X  PIC 9(02).

           05  W0001-FISCAL-PERIOD.
               10  W0001-FISCAL-CC       PIC  X(02)  VALUE SPACES.
               10  W0001-FISCAL-YY       PIC  X(02)  VALUE SPACES.
               10  W0001-FISCAL-MM       PIC  X(02)  VALUE SPACES.

           05  W0001-FYPD.
               10  W0001-FYPD-YY         PIC  X(02)  VALUE SPACES.
               10  W0001-FYPD-MM         PIC  X(02)  VALUE SPACES.

           05  W0001-SELECTION-FLAG      PIC  X(01)  VALUE 'N'.
               88  W0001-LINES-SELECTED              VALUE 'Y'.
               88  W0001-NO-LINES-SELECTED           VALUE 'N'.

           EJECT
      **===========================================================**
      **   FDAT - TRANSACTION ID'S                                 **
      **===========================================================**
           COPY C231WTXN.

           EJECT
      **===========================================================**
      **   PROGRAM MAP AREA                                        **
      **===========================================================**
           COPY M231F01.

           EJECT
      **===========================================================**
      **   CICS COPYBOOKS AREA                                     **
      **===========================================================**
           COPY C108CDBA.

           EJECT
           COPY DFHAID.

           EJECT
           COPY C751CONW.

           EJECT
           COPY C231MSGS.

           EJECT
           COPY C108W900.

           EJECT
           COPY C108W998.

           EJECT
           COPY D972ERRM.

           EJECT
      **===========================================================**
      **   DATE ROUTINE.                                           **
      **===========================================================**
           COPY NSDTREC.

           EJECT
      **===========================================================**
      **   WORKING STORAGE COMMAREA                                **
      **===========================================================**
           COPY C231COMM.
               10  MAP-SAVE-AREA REDEFINES CA-MAP-SAVE-AREA.
                   15  ACTIVE-MAP-FLAG            PIC  X(01).
                       88  MAP-1-ACTIVE           VALUE '1'.
                       88  MAP-A-ACTIVE           VALUE 'A'.

                   15  DELETE-REQUESTED-FLAG      PIC  X(01).
                       88  DELETE-REQUESTED       VALUE 'Y'.
                       88  DELETE-NOT-REQUESTED   VALUE 'N'.

                   15  INSERT-FLAG                PIC  X(01).
                       88  INSERT-SUCCESSFUL      VALUE 'Y'.
                       88  INSERT-NOT-SUCCESSFUL  VALUE 'N'.

                   15  WS-M-INDEX                 PIC S9(04) COMP.

                   15  WS-M-MIN-VALUES.
                       20  WS-M-MIN-DSID-C        PIC  X(08).

                   15  WS-M-MAX-VALUES.
                       20  WS-M-MAX-DSID-C        PIC  X(08).

                   15  WS-MAP-DATA-VALUES  OCCURS 13 TIMES.
                       20  WS-M-F-DSID-C          PIC  X(08).
                       20  WS-M-F-DSID-X          PIC  X(80).
                       20  WS-M-F-CMNT-X          PIC  X(80).

           EJECT
      **===========================================================**
      **   DB2 INCLUDES                                            **
      **===========================================================**
           EXEC SQL
                INCLUDE SQLCA
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231ACS
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231SEC
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DIST
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DSHD
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DSLN
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DSBK
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231BOOK
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231RPT
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231LINE
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231COL
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231ORG
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231RGN
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231PRIM
           END-EXEC.

           EJECT
      **===========================================================**
      **   DB2 CURSORS                                             **
      **===========================================================**

      **===========================================================**
      **   CSR_1 IS THE FORWARD SCROLLING CURSOR                   **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_1 CURSOR FOR
                 SELECT F_DSID_C
                      , F_DSID_X
                      , F_CMNT_X
                   FROM D231.T231DSHD A
                  WHERE F_DSID_C        >= :DCLT231SEC.F-DSID-C
                    AND ( EXISTS
                        (SELECT * FROM D231.T231ACS B
                          WHERE B.A_UID_C    = :DCLT231SEC.A-UID-C
                            AND B.A_UIDTYP_C = 'C')
                       OR EXISTS
                        (SELECT * FROM D231.T231SEC C
                          WHERE C.A_UID_C  = :DCLT231SEC.A-UID-C
                            AND C.F_DSID_C = A.F_DSID_C) )
                  ORDER BY
                        F_DSID_C
           END-EXEC.


      **===========================================================**
      **   CSR_2 IS THE BACKWARD SCROLLING CURSOR                  **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_2 CURSOR FOR
                 SELECT F_DSID_C
                      , F_DSID_X
                      , F_CMNT_X
                   FROM D231.T231DSHD A
                  WHERE F_DSID_C        <= :DCLT231SEC.F-DSID-C
                    AND ( EXISTS
                        (SELECT * FROM D231.T231ACS B
                          WHERE B.A_UID_C    = :DCLT231SEC.A-UID-C
                            AND B.A_UIDTYP_C = 'C')
                       OR EXISTS
                        (SELECT * FROM D231.T231SEC C
                          WHERE C.A_UID_C  = :DCLT231SEC.A-UID-C
                            AND C.F_DSID_C = A.F_DSID_C) )
                  ORDER BY
                        F_DSID_C  DESC
           END-EXEC.

      **===========================================================**
      **   CSR_3 IS THE COPY CURSOR FOR T231DSHD                   **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_3 CURSOR FOR
                 SELECT F_DSID_C
                      , F_DSID_X
                      , F_CMNT_X
                   FROM D231.T231DSHD
                  WHERE F_DSID_C  = :DCLT231DSHD.F-DSID-C
                  ORDER BY
                        F_DSID_C
           END-EXEC.

      **===========================================================**
      **   CSR_4 IS THE COPY CURSOR T231DSLN                       **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_4 CURSOR FOR
                 SELECT F_DSID_C
                      , F_DSLN_N
                      , F_DSID_X
                      , A_DEST_C
                      , A_NOVA01_C
                      , A_NOVA02_C
                      , A_NOVA03_C
                      , A_MICRO_C
                   FROM D231.T231DSLN
                  WHERE F_DSID_C  = :DCLT231DSHD.F-DSID-C
                  ORDER BY
                        F_DSID_C
                      , F_DSLN_N
           END-EXEC.

      **===========================================================**
      **   CSR_5 IS THE COPY CURSOR T231DSBK                       **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_5 CURSOR FOR
                 SELECT F_DSID_C
                      , F_DSLN_N
                      , F_BKID_C
                      , A_CPYP1_N
                      , A_CPYP2_N
                      , A_CPYFN_N
                      , A_CPYQ1_N
                      , A_CPYQ2_N
                      , A_CPYQ3_N
                      , A_CPYQN_N
                   FROM D231.T231DSBK
                  WHERE F_DSID_C  = :DCLT231DSHD.F-DSID-C
                  ORDER BY
                        F_DSID_C
                      , F_DSLN_N
                      , F_BKID_C
           END-EXEC.

      **===========================================================**
      **   END OF WORKING STORAGE SECTION                          **
      **===========================================================**
           EJECT
       LINKAGE SECTION.

       01  DFHCOMMAREA.
           05  FILLER                   PICTURE X(4096).

           EJECT
       PROCEDURE DIVISION.

           EXEC CICS HANDLE ABEND
                LABEL    (Z900-HANDLE-ERROR)
           END-EXEC.

           EXEC CICS HANDLE CONDITION
                ERROR    (Z900-HANDLE-ERROR)
                ILLOGIC  (Z900-HANDLE-ERROR)
                DSIDERR  (Z900-HANDLE-ERROR)
                INVREQ   (Z900-HANDLE-ERROR)
                IOERR    (Z900-HANDLE-ERROR)
                ISCINVREQ(Z900-HANDLE-ERROR)
                NOSPACE  (Z900-HANDLE-ERROR)
           END-EXEC.

       A000-MAINLINE.

           MOVE 'A000'      TO CA-PARAGRAPH-NBR.

           PERFORM A100-INITIALIZATION.

           IF  CA-CURRENT-PGM = PROGRAM-NAME
               PERFORM A300-ACCEPT-SCREEN

               EVALUATE TRUE
                   WHEN MAP-1-ACTIVE
                        PERFORM A001-PROCESS-MAP-1
                   WHEN MAP-A-ACTIVE
                        PERFORM A002-PROCESS-MAP-A
               END-EVALUATE
           END-IF.

           PERFORM A200-DISPLAY-SCREEN.

           PERFORM Y100-REPEAT-PROGRAM.

           EJECT
       A001-PROCESS-MAP-1.

           MOVE 'A001'      TO CA-PARAGRAPH-NBR.

           SET INSERT-NOT-SUCCESSFUL    TO TRUE.

           IF  EIBAID NOT EQUAL DFHPF10
               SET DELETE-NOT-REQUESTED TO TRUE
           END-IF.

           EVALUATE TRUE
               WHEN EIBAID = DFHENTER
                    PERFORM B000-PROCESS-ENTER-KEY
                    IF  W0001-LINES-SELECTED
                        MOVE DIST-MAINT-TXN-ID TO W0001-TXN-ID
                        PERFORM Y700-START-TRANSACTION
                    END-IF
               WHEN EIBAID = DFHCLEAR
                    PERFORM Y400-RETURN-TO-CICS
               WHEN EIBAID = DFHPF3
                    IF  CA-CORPORATE-USER
                        MOVE MAIN-MENU-TXN-ID TO W0001-TXN-ID
                        PERFORM Y700-START-TRANSACTION
                    ELSE
                        PERFORM Y400-RETURN-TO-CICS
                    END-IF
               WHEN EIBAID = DFHPF4
                    MOVE BOOK-SEARCH-TXN-ID TO W0001-TXN-ID
                    PERFORM Y700-START-TRANSACTION
               WHEN EIBAID = DFHPF5
                    IF  CA-CORPORATE-USER
                        PERFORM B700-CHECK-FOR-SELECTION
                        IF  W0001-LINES-SELECTED
                            SET CA-UPDATE      TO TRUE
                            MOVE W9999-MSG-019 TO M-MSG-22AI
                            MOVE -1            TO M-DSID-CAL
                            SET MAP-A-ACTIVE TO TRUE
                        ELSE
                            MOVE W9999-MSG-045 TO M-MSG-22I
                            MOVE -1            TO M-DISTKEY-CL
                            SET ERRORS         TO TRUE
                        END-IF
                    ELSE
                        SET ERRORS           TO TRUE
                        MOVE W9999-MSG-015   TO M-MSG-22I
                        MOVE -1              TO M-DISTKEY-CL
                    END-IF
               WHEN EIBAID = DFHPF6
                    IF  CA-CORPORATE-USER
                        PERFORM B700-CHECK-FOR-SELECTION
                        SET MAP-A-ACTIVE     TO TRUE
                        SET CA-ENTRY         TO TRUE
                        MOVE W9999-MSG-021   TO M-MSG-22AI
                        MOVE -1              TO M-DSID-CAL
                    ELSE
                        SET ERRORS           TO TRUE
                        MOVE W9999-MSG-015   TO M-MSG-22I
                        MOVE -1              TO M-DISTKEY-CL
                    END-IF
               WHEN EIBAID = DFHPF7
                    PERFORM D000-PROCESS-PREV-PAGE
                    IF  M-DSID-CI (1)  EQUAL SPACES
                        MOVE SPACES TO WS-M-MAX-DSID-C
                        SET NO-ERRORS  TO TRUE
                        PERFORM C000-PROCESS-NEXT-PAGE
                        MOVE W9999-MSG-005 TO M-MSG-22I
                    END-IF
               WHEN EIBAID = DFHPF8
                    PERFORM C000-PROCESS-NEXT-PAGE
               WHEN EIBAID = DFHPF10
                    IF  CA-CORPORATE-USER
                        PERFORM I000-DELETE-T231DSHD-ENTRIES
                        IF  NO-ERRORS
                            MOVE WS-M-MIN-VALUES
                              TO WS-M-MAX-VALUES
                            PERFORM C000-PROCESS-NEXT-PAGE
                            MOVE W9999-MSG-014 TO M-MSG-22AI
                        END-IF
                    ELSE
                        SET ERRORS           TO TRUE
                        MOVE W9999-MSG-015   TO M-MSG-22I
                        MOVE -1              TO M-DISTKEY-CL
                    END-IF
               WHEN EIBAID = DFHPF11
                    IF  CA-CORPORATE-USER
                        PERFORM H000-COPY-TO-NEW-DIST
                        IF  NO-ERRORS
                            MOVE WS-M-MIN-VALUES
                              TO WS-M-MAX-VALUES
                            PERFORM C000-PROCESS-NEXT-PAGE
                            MOVE W9999-MSG-020 TO M-MSG-22I
                        END-IF
                    ELSE
                        SET ERRORS           TO TRUE
                        MOVE W9999-MSG-015   TO M-MSG-22I
                        MOVE -1              TO M-DISTKEY-CL
                    END-IF
               WHEN OTHER
                    MOVE -1            TO M-DISTKEY-CL
                    SET ERRORS         TO TRUE
                    MOVE W9999-MSG-002 TO M-MSG-22I
           END-EVALUATE.

           EJECT
       A002-PROCESS-MAP-A.

           MOVE 'A002'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN EIBAID = DFHENTER
                    PERFORM E100-PROCESS-ENTER-KEY
               WHEN EIBAID = DFHCLEAR
                    PERFORM Y400-RETURN-TO-CICS
               WHEN EIBAID = DFHPF3
                    SET MAP-1-ACTIVE    TO TRUE
                    SET CA-INQUIRY      TO TRUE
                    IF  INSERT-SUCCESSFUL
                        MOVE WS-M-MIN-VALUES
                          TO WS-M-MAX-VALUES
                        PERFORM C000-PROCESS-NEXT-PAGE
                    ELSE
                        PERFORM B400-DISPLAY-SCREEN-1
                    END-IF
                    SET INSERT-NOT-SUCCESSFUL TO TRUE
               WHEN EIBAID = DFHPF5
                    PERFORM E200-UPDATE-T231DSHD-HDR
               WHEN EIBAID = DFHPF6
                    PERFORM E400-INSERT-T231DSHD-HDR
               WHEN EIBAID = DFHPF12
                    SET MAP-1-ACTIVE    TO TRUE
                    SET CA-INQUIRY      TO TRUE
                    IF  INSERT-SUCCESSFUL
                        MOVE WS-M-MIN-VALUES
                          TO WS-M-MAX-VALUES
                        PERFORM C000-PROCESS-NEXT-PAGE
                    ELSE
                        PERFORM B400-DISPLAY-SCREEN-1
                    END-IF
                    SET INSERT-NOT-SUCCESSFUL TO TRUE
               WHEN OTHER
                    MOVE -1             TO M-DSID-CAL
                    SET ERRORS          TO TRUE
                    MOVE W9999-MSG-002  TO M-MSG-22AI
           END-EVALUATE.

           EJECT
       A100-INITIALIZATION.

           MOVE 'A100'      TO CA-PARAGRAPH-NBR.

           IF  EIBCALEN NOT EQUAL ZEROES
               MOVE DFHCOMMAREA TO WS-COMMAREA
               IF  CA-CURRENT-PGM = PROGRAM-NAME
                   CONTINUE
               ELSE
                   MOVE CA-CURRENT-PGM TO CA-PREV-PGM
                   MOVE CA-CURRENT-TXN TO CA-PREV-TXN
                   PERFORM A150-SETUP-COMMAREA
               END-IF
           ELSE
               MOVE MAIN-MENU-TXN-ID  TO W0001-TXN-ID
               PERFORM Y600-START-TRANSACTION
           END-IF.

           EJECT
       A150-SETUP-COMMAREA.

           MOVE 'A150'      TO CA-PARAGRAPH-NBR.

           EXEC CICS ASKTIME
                ABSTIME (W0001-ABSTIME)
           END-EXEC.

           EXEC CICS FORMATTIME
                ABSTIME (W0001-ABSTIME)
                TIME    (W0001-HHCMMCSS)
                TIMESEP
                MMDDYY  (W0001-MMSDDSYY)
                DATESEP
                YEAR    (W0001-YYYY)
           END-EXEC.

           MOVE W0001-MMSDDSYY    TO M-DATEI
                                     CA-DATE.
           MOVE W0001-HHCMMCSS    TO M-TIMEI
                                     CA-TIME.

           EJECT
       A200-DISPLAY-SCREEN.

           MOVE 'A200'      TO CA-PARAGRAPH-NBR.

           IF  CA-CURRENT-PGM = PROGRAM-NAME
               PERFORM A210-SAVE-MAP
           ELSE
               INITIALIZE MAP-SAVE-AREA
               INITIALIZE M231F01I
               INITIALIZE M231F1AI
               SET MAP-1-ACTIVE    TO TRUE
               MOVE MAP-NAME-1     TO MAP-NAME
               MOVE -1     TO M-ACT-CL (1)
               MOVE SPACES TO WS-M-MAX-DSID-C
               MOVE SPACES TO CA-CURR-F-DSID-C
               MOVE SPACES TO CA-CURR-F-DSID-N
               PERFORM C000-PROCESS-NEXT-PAGE
           END-IF.

           EVALUATE TRUE
               WHEN MAP-1-ACTIVE
                    PERFORM A220-SET-SCREEN-1-ATTRIBUTES
                    MOVE MAP-NAME-1 TO MAP-NAME
                    MOVE M231F01I   TO MAP-DATA
               WHEN MAP-A-ACTIVE
                    PERFORM A221-SET-SCREEN-A-ATTRIBUTES
                    MOVE MAP-NAME-A TO MAP-NAME
                    MOVE M231F1AI   TO MAP-DATA
           END-EVALUATE.

           EXEC CICS HANDLE CONDITION
                MAPFAIL (Z100-MAPFAIL)
                ERROR   (Z200-NO-MAPFAIL)
           END-EXEC.

           EXEC CICS SEND
                MAP    (MAP-NAME)
                MAPSET (SET-NAME)
                FROM   (MAP-DATA)
                ERASE
                CURSOR
           END-EXEC.

           EJECT
       A210-SAVE-MAP.

           MOVE 'A210'      TO CA-PARAGRAPH-NBR.

           EJECT
       A220-SET-SCREEN-1-ATTRIBUTES.

           MOVE 'A220'      TO CA-PARAGRAPH-NBR.

           MOVE ATTR-ALPHA-PROT-BRT-PEN
             TO M-UID-CA
                M-FYPDA
                M-DATEA
                M-TIMEA
                M-MSG-22A.

           MOVE ATTR-ALPHA-UNPROT-MDT
             TO M-DISTKEY-CA.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT

               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-ACT-CA        (W0001-X)

               MOVE ATTR-ALPHA-PROT-MDT
                 TO M-DSID-CA       (W0001-X)
                    M-DSID-XA       (W0001-X)

               IF  M-DSID-CI (W0001-X) EQUAL SPACES
                   MOVE ATTR-ALPHA-PROT-MDT
                     TO M-ACT-CA    (W0001-X)
                   MOVE SPACES
                     TO M-ACT-CI (W0001-X)
               ELSE
                   MOVE M-ACT-CI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA  TO M-ACT-CI (W0001-X)
               END-IF
           END-PERFORM.

           MOVE M-DISTKEY-CI   TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-DISTKEY-CI.

           MOVE CA-OP-ID       TO M-UID-CI.
           MOVE CA-FYPD        TO M-FYPDI.
           MOVE CA-DATE        TO M-DATEI.
           MOVE CA-TIME        TO M-TIMEI.

           EJECT
       A221-SET-SCREEN-A-ATTRIBUTES.

           MOVE 'A221'      TO CA-PARAGRAPH-NBR.

           MOVE ATTR-ALPHA-PROT-BRT-PEN
             TO M-UID-CAA
                M-FYPDAA
                M-DATEAA
                M-TIMEAA
                M-MSG-22AA
                M-MODEAA.

           IF  CA-ENTRY
               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-DSID-CAA
                    M-DSID-XAA
                    M-CMNT-XAA
               MOVE ' ** ADD **' TO M-MODEAI
           ELSE
               MOVE ATTR-ALPHA-PROT-MDT
                 TO M-DSID-CAA
               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-DSID-XAA
                    M-CMNT-XAA
               MOVE '  UPDATE  ' TO M-MODEAI
           END-IF.

           MOVE M-DSID-CAI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-DSID-CAI.

           MOVE M-DSID-XAI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-DSID-XAI.

           MOVE M-CMNT-XAI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-CMNT-XAI.

           MOVE CA-OP-ID       TO M-UID-CAI.
           MOVE CA-FYPD        TO M-FYPDAI.
           MOVE CA-DATE        TO M-DATEAI.
           MOVE CA-TIME        TO M-TIMEAI.

           EJECT
       A300-ACCEPT-SCREEN.

           MOVE 'A300'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN MAP-1-ACTIVE
                    MOVE MAP-NAME-1 TO MAP-NAME
               WHEN MAP-A-ACTIVE
                    MOVE MAP-NAME-A TO MAP-NAME
           END-EVALUATE.

           EXEC CICS IGNORE CONDITION
                MAPFAIL
           END-EXEC.

           EXEC CICS HANDLE CONDITION
                ERROR (Z200-NO-MAPFAIL)
           END-EXEC.

           EXEC CICS RECEIVE
                MAP    (MAP-NAME)
                MAPSET (SET-NAME)
                INTO   (MAP-DATA)
           END-EXEC.

           EVALUATE TRUE
               WHEN MAP-1-ACTIVE
                    MOVE MAP-DATA TO M231F01I
                    PERFORM A310-PROCESS-MAP-1-FIELDS
               WHEN MAP-A-ACTIVE
                    MOVE MAP-DATA TO M231F1AI
                    PERFORM A311-PROCESS-MAP-A-FIELDS
           END-EVALUATE.

           EJECT
       A310-PROCESS-MAP-1-FIELDS.

           MOVE 'A310'      TO CA-PARAGRAPH-NBR.

           INSPECT M-DISTKEY-CI REPLACING ALL '_' BY ' '.

           INSPECT M-DISTKEY-CI REPLACING ALL LOW-VALUES BY ' '.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                   INSPECT M-ACT-CI (W0001-X) REPLACING ALL '_' BY ' '
                   INSPECT M-ACT-CI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
           END-PERFORM.

           EJECT
       A311-PROCESS-MAP-A-FIELDS.

           MOVE 'A311'      TO CA-PARAGRAPH-NBR.

           INSPECT M-DSID-CAI REPLACING ALL '_' BY ' '.
           INSPECT M-DSID-XAI REPLACING ALL '_' BY ' '.
           INSPECT M-CMNT-XAI REPLACING ALL '_' BY ' '.

           INSPECT M-DSID-CAI REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-DSID-XAI REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-CMNT-XAI REPLACING ALL LOW-VALUES BY ' '.

           EJECT
       B000-PROCESS-ENTER-KEY.

           MOVE 'B000'      TO CA-PARAGRAPH-NBR.

           SET W0001-NO-LINES-SELECTED TO TRUE.

           IF  M-DISTKEY-CI > SPACES
               PERFORM B100-VALIDATE-KEY
           ELSE
               PERFORM B300-CHECK-FOR-SELECTION
               IF  NO-ERRORS
                   IF  W0001-LINES-SELECTED
                       CONTINUE
                   ELSE
                       MOVE W9999-MSG-001  TO M-MSG-22I
                       SET ERRORS          TO TRUE
                       MOVE -1             TO M-DISTKEY-CL
                   END-IF
               END-IF
           END-IF.

           EJECT
       B100-VALIDATE-KEY.

           MOVE 'B100'      TO CA-PARAGRAPH-NBR.

           MOVE CA-OP-ID         TO A-UID-C     IN DCLT231SEC.
           MOVE 'D'              TO DB-RECTYP-C IN DCLT231SEC.
           MOVE M-DISTKEY-CI     TO F-DSID-C    IN DCLT231SEC.

           EXEC SQL
                SELECT F_DSID_C
                     , F_DSID_X
                     , F_CMNT_X
                  INTO :DCLT231DSHD.F-DSID-C
                     , :DCLT231DSHD.F-DSID-X
                     , :DCLT231DSHD.F-CMNT-X
                  FROM D231.T231DSHD A
                 WHERE F_DSID_C         = :DCLT231SEC.F-DSID-C
                   AND ( EXISTS
                       (SELECT * FROM D231.T231ACS B
                         WHERE B.A_UID_C    = :DCLT231SEC.A-UID-C
                           AND B.A_UIDTYP_C = 'C')
                      OR EXISTS
                       (SELECT * FROM D231.T231SEC C
                         WHERE C.A_UID_C  = :DCLT231SEC.A-UID-C
                           AND C.F_DSID_C = A.F_DSID_C) )
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               SET W0001-LINES-SELECTED TO TRUE
               MOVE F-DSID-C IN DCLT231DSHD
                 TO CA-CURR-F-DSID-C
               MOVE F-DSID-X IN DCLT231DSHD
                 TO CA-CURR-F-DSID-X
           ELSE
               MOVE M-DISTKEY-CI TO F-DSID-C    IN DCLT231SEC
                                    WS-M-MAX-DSID-C
               PERFORM C000-PROCESS-NEXT-PAGE
               MOVE SPACES       TO M-DISTKEY-CI
           END-IF.

           EJECT
       B300-CHECK-FOR-SELECTION.

           MOVE 'B300'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                OR W0001-LINES-SELECTED
                   IF  M-ACT-CI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED TO TRUE
                       MOVE M-DSID-CI (W0001-X)
                         TO CA-CURR-F-DSID-C
                       MOVE M-DSID-XI (W0001-X)
                         TO CA-CURR-F-DSID-X
                   END-IF
           END-PERFORM.

           EJECT
       B400-DISPLAY-SCREEN-1.

           MOVE 'B400'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-IX FROM 1 BY 1
             UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
               MOVE WS-M-F-DSID-C (W0001-IX)
                 TO M-DSID-CI     (W0001-IX)
               MOVE WS-M-F-DSID-X (W0001-IX)
                 TO M-DSID-XI     (W0001-IX)
           END-PERFORM.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22I
               MOVE -1             TO M-DISTKEY-CL
           END-IF.

           EJECT
       B700-CHECK-FOR-SELECTION.

           MOVE 'B700'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                OR W0001-LINES-SELECTED
                   IF  M-ACT-CI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED  TO TRUE
                       MOVE W0001-X              TO WS-M-INDEX
                       PERFORM B710-DISPLAY-SCREEN-A
                   END-IF
           END-PERFORM.

           EJECT
       B710-DISPLAY-SCREEN-A.

           MOVE 'B710'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-F-DSID-C      (WS-M-INDEX)
             TO M-DSID-CAI.
           MOVE WS-M-F-DSID-X      (WS-M-INDEX)
             TO M-DSID-XAI.
           MOVE WS-M-F-CMNT-X      (WS-M-INDEX)
             TO M-CMNT-XAI.

           EJECT
       C000-PROCESS-NEXT-PAGE.

           MOVE 'C000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM C200-GET-T231SEC
               IF  W0001-IX > 1 AND <= W0001-SCREEN-LINE-LIMIT
                   PERFORM UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
                       PERFORM C400-MOVE-BLANKS-TO-SCREEN
                       ADD +1 TO W0001-IX
                   END-PERFORM
               ELSE
                   IF  W0001-IX = 1 AND EIBAID = DFHENTER
                       PERFORM VARYING W0001-IX FROM 1 BY 1
                         UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
                           PERFORM C400-MOVE-BLANKS-TO-SCREEN
                       END-PERFORM
                   END-IF
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
                   PERFORM C400-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           EJECT
       C200-GET-T231SEC.

           MOVE 'C200'      TO CA-PARAGRAPH-NBR.

           MOVE CA-OP-ID         TO A-UID-C     IN DCLT231SEC.
           MOVE WS-M-MAX-DSID-C  TO F-DSID-C    IN DCLT231SEC.

           EXEC SQL
                OPEN CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX > W0001-SCREEN-LINE-LIMIT
               EXEC SQL
                    FETCH CSR_1
                     INTO :DCLT231SEC.F-DSID-C
                        , :DCLT231DSHD.F-DSID-X
                        , :DCLT231DSHD.F-CMNT-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   IF  W0001-IX = 1
                       MOVE F-DSID-C          IN DCLT231SEC
                         TO WS-M-MIN-DSID-C
                   END-IF

                   MOVE F-DSID-C          IN DCLT231SEC
                     TO M-DSID-CI         (W0001-IX)
                        WS-M-F-DSID-C     (W0001-IX)
                   MOVE F-DSID-X          IN DCLT231DSHD
                     TO M-DSID-XI         (W0001-IX)
                        WS-M-F-DSID-X     (W0001-IX)
                   MOVE F-CMNT-X          IN DCLT231DSHD
                     TO WS-M-F-CMNT-X     (W0001-IX)
                   ADD +1 TO W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-DSID-C          IN DCLT231SEC
             TO WS-M-MAX-DSID-C.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-004  TO M-MSG-22I
               SET ERRORS          TO TRUE
               MOVE -1             TO M-DISTKEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22I
               MOVE -1             TO M-DISTKEY-CL
           END-IF.

           EJECT
       C400-MOVE-BLANKS-TO-SCREEN.

           MOVE 'C400'      TO CA-PARAGRAPH-NBR.

           MOVE SPACES TO M-ACT-CI       (W0001-IX)
                          M-DSID-CI      (W0001-IX)
                          M-DSID-XI      (W0001-IX)
                          WS-M-F-DSID-C  (W0001-IX)
                          WS-M-F-DSID-X  (W0001-IX)
                          WS-M-F-CMNT-X  (W0001-IX).

           EJECT
       D000-PROCESS-PREV-PAGE.

           MOVE 'D000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM D200-GET-T231SEC
               IF  W0001-IX >= 1 AND < W0001-SCREEN-LINE-LIMIT
                   PERFORM UNTIL W0001-IX < 1
                       PERFORM C400-MOVE-BLANKS-TO-SCREEN
                       SUBTRACT +1 FROM W0001-IX
                   END-PERFORM
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
                   PERFORM C400-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           IF  NO-ERRORS
               MOVE -1            TO M-ACT-CL(1)
               MOVE W9999-MSG-003 TO M-MSG-22I
           END-IF.

           EJECT
       D200-GET-T231SEC.

           MOVE 'D200'      TO CA-PARAGRAPH-NBR.

           MOVE CA-OP-ID         TO A-UID-C     IN DCLT231SEC.
           MOVE WS-M-MIN-DSID-C  TO F-DSID-C    IN DCLT231SEC.

           EXEC SQL
                OPEN CSR_2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE W0001-SCREEN-LINE-LIMIT TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX < 1
               EXEC SQL
                    FETCH CSR_2
                     INTO :DCLT231SEC.F-DSID-C
                        , :DCLT231DSHD.F-DSID-X
                        , :DCLT231DSHD.F-CMNT-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE F-DSID-C          IN DCLT231SEC
                     TO M-DSID-CI         (W0001-IX)
                        WS-M-F-DSID-C     (W0001-IX)
                   MOVE F-DSID-X          IN DCLT231DSHD
                     TO M-DSID-XI         (W0001-IX)
                        WS-M-F-DSID-X     (W0001-IX)
                   MOVE F-CMNT-X          IN DCLT231DSHD
                     TO WS-M-F-CMNT-X     (W0001-IX)

                   IF  W0001-IX = W0001-SCREEN-LINE-LIMIT
                       MOVE F-DSID-C          IN DCLT231SEC
                         TO WS-M-MAX-DSID-C
                   END-IF

                   SUBTRACT +1 FROM W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-DSID-C          IN DCLT231SEC
             TO WS-M-MIN-DSID-C.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-005  TO M-MSG-22I
               SET ERRORS          TO TRUE
               MOVE -1             TO M-DISTKEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22I
               MOVE -1             TO M-DISTKEY-CL
           END-IF.

           EJECT
       E100-PROCESS-ENTER-KEY.

           MOVE 'E100'      TO CA-PARAGRAPH-NBR.

           IF  CA-ENTRY
               MOVE W9999-MSG-021  TO M-MSG-22AI
               MOVE -1             TO M-DSID-XAL
           END-IF.

           IF  CA-UPDATE
               MOVE W9999-MSG-019  TO M-MSG-22AI
               MOVE -1             TO M-DSID-XAL
           END-IF.

           EJECT
       E200-UPDATE-T231DSHD-HDR.

           MOVE 'E200'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-F-DSID-C      (WS-M-INDEX)
             TO F-DSID-C           IN DCLT231DSHD.

           MOVE M-DSID-XAI
             TO F-DSID-X           IN DCLT231DSHD
                WS-M-F-DSID-X      (WS-M-INDEX).

           MOVE M-CMNT-XAI
             TO F-CMNT-X           IN DCLT231DSHD
                WS-M-F-CMNT-X      (WS-M-INDEX).

           MOVE CA-OP-ID
             TO DB-UPD-X           IN DCLT231DSHD.

           PERFORM E300-UPDATE-T231DSHD.

           IF  DB2-NORMAL
               CONTINUE
           ELSE
               SET ERRORS          TO TRUE
               MOVE W9999-MSG-023  TO M-MSG-22AI
               MOVE -1             TO M-DSID-XAL
           END-IF.

           IF  NO-ERRORS
               MOVE W9999-MSG-013  TO M-MSG-22AI
               MOVE -1             TO M-DSID-XAL
           END-IF.

           EJECT
       E300-UPDATE-T231DSHD.

           MOVE 'E300'      TO CA-PARAGRAPH-NBR.

           EXEC SQL
                UPDATE D231.T231DSHD
                   SET F_DSID_X      = :DCLT231DSHD.F-DSID-X
                     , F_CMNT_X      = :DCLT231DSHD.F-CMNT-X
                     , DB_UPD_D      = CURRENT DATE
                     , DB_UPD_T      = CURRENT TIME
                     , DB_UPD_X      = :DCLT231DSHD.DB-UPD-X
                 WHERE F_DSID_C      = :DCLT231DSHD.F-DSID-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       E400-INSERT-T231DSHD-HDR.

           MOVE 'E400'      TO CA-PARAGRAPH-NBR.

           IF  CA-UPDATE
               SET CA-ENTRY        TO TRUE
               MOVE W9999-MSG-021  TO M-MSG-22AI
               MOVE -1             TO M-DSID-XAL
               SET ERRORS          TO TRUE
           ELSE
               PERFORM E410-INSERT-T231DSHD-HDR
           END-IF.

           EJECT
       E410-INSERT-T231DSHD-HDR.

           MOVE 'E410'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231DSHD.

           MOVE M-DSID-CAI
             TO F-DSID-C           IN DCLT231DSHD.
           MOVE M-DSID-XAI
             TO F-DSID-X           IN DCLT231DSHD.
           MOVE M-CMNT-XAI
             TO F-CMNT-X           IN DCLT231DSHD.
           MOVE CA-OP-ID
             TO DB-UPD-X           IN DCLT231DSHD.

           SET DUP-KEY  TO TRUE.
           PERFORM E500-INSERT-T231DSHD.

           IF  DB2-NORMAL
               SET INSERT-SUCCESSFUL TO TRUE
               MOVE +1  TO W0001-IX

               MOVE F-DSID-C            IN DCLT231DSHD
                 TO WS-M-F-DSID-C       (W0001-IX)
               MOVE F-DSID-X            IN DCLT231DSHD
                 TO WS-M-F-DSID-X       (W0001-IX)
               MOVE F-CMNT-X            IN DCLT231DSHD
                 TO WS-M-F-CMNT-X       (W0001-IX)

               MOVE +1  TO WS-M-INDEX

               MOVE F-DSID-C            IN DCLT231DSHD
                 TO WS-M-MIN-DSID-C
           ELSE
               SET ERRORS          TO TRUE
               MOVE W9999-MSG-022  TO M-MSG-22AI
               MOVE -1             TO M-DSID-XAL
           END-IF.

           IF  NO-ERRORS
               MOVE W9999-MSG-012  TO M-MSG-22AI
               MOVE -1             TO M-DSID-XAL
           END-IF.

           EJECT
       E500-INSERT-T231DSHD.

           MOVE 'E500' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231DSHD
                 ( F_DSID_C
                 , F_DSID_X
                 , F_CMNT_X
                 , DB_UPD_D
                 , DB_UPD_T
                 , DB_UPD_X )
             VALUES
                 ( :DCLT231DSHD.F-DSID-C
                 , :DCLT231DSHD.F-DSID-X
                 , :DCLT231DSHD.F-CMNT-X
                 , CURRENT DATE
                 , CURRENT TIME
                 , :DCLT231DSHD.DB-UPD-X )
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       H000-COPY-TO-NEW-DIST.

           MOVE 'H000' TO CA-PARAGRAPH-NBR.

           PERFORM H100-VALIDATE-KEYS.

           IF  NO-ERRORS
               PERFORM H200-PROCESS-COPY-CURSOR
               IF  NO-ERRORS
                   PERFORM H300-PROCESS-COPY-CURSOR
               END-IF
               IF  NO-ERRORS
                   PERFORM H400-PROCESS-COPY-CURSOR
               END-IF
               IF  NO-ERRORS
                   CONTINUE
               ELSE
                   PERFORM Y600-ROLLBACK
                   SET ERRORS          TO TRUE
                   MOVE -1             TO M-DISTKEY-CL
                   MOVE W9999-MSG-043  TO M-MSG-22I
               END-IF
           END-IF.

           IF  NO-ERRORS
               MOVE -1             TO M-DISTKEY-CL
               MOVE W9999-MSG-020  TO M-MSG-22I
               INITIALIZE             WS-M-MIN-VALUES
               MOVE M-DSID-CAI     TO WS-M-MIN-DSID-C
               MOVE SPACES         TO M-ACT-CI (WS-M-INDEX)
               MOVE SPACES         TO M-DISTKEY-CI
           END-IF.

           EJECT
       H100-VALIDATE-KEYS.

           MOVE 'H100' TO CA-PARAGRAPH-NBR.

           MOVE ZEROES TO W0001-COPY-CTR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                   IF  M-ACT-CI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED  TO TRUE
                       MOVE W0001-X              TO WS-M-INDEX
                       ADD +1                    TO W0001-COPY-CTR
                   END-IF
           END-PERFORM.

           IF  W0001-LINES-SELECTED
               IF  W0001-COPY-CTR > +1
                   MOVE W9999-MSG-038  TO M-MSG-22I
                   MOVE -1             TO M-ACT-CL(1)
                   SET ERRORS          TO TRUE
               END-IF
           ELSE
               SET ERRORS              TO TRUE
               MOVE -1                 TO M-DISTKEY-CL
               MOVE W9999-MSG-039      TO M-MSG-22I
           END-IF.

           IF  NO-ERRORS
               IF  M-DISTKEY-CI = SPACES
                   MOVE W9999-MSG-044  TO M-MSG-22I
                   MOVE -1             TO M-DISTKEY-CL
                   SET ERRORS          TO TRUE
               END-IF
           END-IF.

           EJECT
       H200-PROCESS-COPY-CURSOR.

           MOVE 'H200'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-F-DSID-C (WS-M-INDEX) TO F-DSID-C IN DCLT231DSHD.

           EXEC SQL
                OPEN CSR_3
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR ERRORS
               EXEC SQL
                    FETCH CSR_3
                     INTO :DCLT231DSHD.F-DSID-C
                        , :DCLT231DSHD.F-DSID-X
                        , :DCLT231DSHD.F-CMNT-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE M-DISTKEY-CI TO F-DSID-C IN DCLT231DSHD
                   SET DUP-KEY  TO TRUE
                   MOVE CA-OP-ID TO DB-UPD-X  IN DCLT231DSHD
                   PERFORM E500-INSERT-T231DSHD
                   IF  DB2-NORMAL
                       CONTINUE
                   ELSE
                       SET ERRORS TO TRUE
                   END-IF
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_3
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.


           EJECT
       H300-PROCESS-COPY-CURSOR.

           MOVE 'H300'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-F-DSID-C (WS-M-INDEX) TO F-DSID-C IN DCLT231DSHD.

           EXEC SQL
                OPEN CSR_4
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR ERRORS
               EXEC SQL
                    FETCH CSR_4
                     INTO :DCLT231DSLN.F-DSID-C
                        , :DCLT231DSLN.F-DSLN-N
                        , :DCLT231DSLN.A-DEST-C
                        , :DCLT231DSLN.A-NOVA01-C
                        , :DCLT231DSLN.A-NOVA02-C
                        , :DCLT231DSLN.A-NOVA03-C
                        , :DCLT231DSLN.A-MICRO-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE M-DISTKEY-CI TO F-DSID-C IN DCLT231DSLN
                   SET DUP-KEY  TO TRUE
                   MOVE CA-OP-ID TO DB-UPD-X  IN DCLT231DSLN
                   PERFORM H310-INSERT-T231DSLN
                   IF  DB2-NORMAL
                       CONTINUE
                   ELSE
                       SET ERRORS TO TRUE
                   END-IF
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_4
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       H310-INSERT-T231DSLN.

           MOVE 'H310' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231DSLN
                 ( F_DSID_C
                 , F_DSLN_N
                 , A_DEST_C
                 , A_NOVA01_C
                 , A_NOVA02_C
                 , A_NOVA03_C
                 , A_MICRO_C
                 , DB_UPD_D
                 , DB_UPD_T
                 , DB_UPD_X )
             VALUES
                 ( :DCLT231DSLN.F-DSID-C
                 , :DCLT231DSLN.F-DSLN-N
                 , :DCLT231DSLN.A-DEST-C
                 , :DCLT231DSLN.A-NOVA01-C
                 , :DCLT231DSLN.A-NOVA02-C
                 , :DCLT231DSLN.A-NOVA03-C
                 , :DCLT231DSLN.A-MICRO-C
                 , CURRENT DATE
                 , CURRENT TIME
                 , :DCLT231DSLN.DB-UPD-X )
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       H400-PROCESS-COPY-CURSOR.

           MOVE 'H400'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-F-DSID-C (WS-M-INDEX) TO F-DSID-C IN DCLT231DSHD.

           EXEC SQL
                OPEN CSR_5
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR ERRORS
               EXEC SQL
                    FETCH CSR_5
                     INTO :DCLT231DSBK.F-DSID-C
                        , :DCLT231DSBK.F-DSLN-N
                        , :DCLT231DSBK.F-BKID-C
                        , :DCLT231DSBK.A-CPYP1-N
                        , :DCLT231DSBK.A-CPYP2-N
                        , :DCLT231DSBK.A-CPYFN-N
                        , :DCLT231DSBK.A-CPYQ1-N
                        , :DCLT231DSBK.A-CPYQ2-N
                        , :DCLT231DSBK.A-CPYQ3-N
                        , :DCLT231DSBK.A-CPYQN-N
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE M-DISTKEY-CI TO F-DSID-C IN DCLT231DSBK
                   SET DUP-KEY  TO TRUE
                   MOVE CA-OP-ID TO DB-UPD-X  IN DCLT231DSBK
                   PERFORM H410-INSERT-T231DSBK
                   IF  DB2-NORMAL
                       CONTINUE
                   ELSE
                       SET ERRORS TO TRUE
                   END-IF
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_5
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       H410-INSERT-T231DSBK.

           MOVE 'H410' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231DSBK
                 ( F_DSID_C
                 , F_DSLN_N
                 , F_BKID_C
                 , A_CPYP1_N
                 , A_CPYP2_N
                 , A_CPYFN_N
                 , A_CPYQ1_N
                 , A_CPYQ2_N
                 , A_CPYQ3_N
                 , A_CPYQN_N
                 , DB_UPD_D
                 , DB_UPD_T
                 , DB_UPD_X )
             VALUES
                 ( :DCLT231DSBK.F-DSID-C
                 , :DCLT231DSBK.F-DSLN-N
                 , :DCLT231DSBK.F-BKID-C
                 , :DCLT231DSBK.A-CPYP1-N
                 , :DCLT231DSBK.A-CPYP2-N
                 , :DCLT231DSBK.A-CPYFN-N
                 , :DCLT231DSBK.A-CPYQ1-N
                 , :DCLT231DSBK.A-CPYQ2-N
                 , :DCLT231DSBK.A-CPYQ3-N
                 , :DCLT231DSBK.A-CPYQN-N
                 , CURRENT DATE
                 , CURRENT TIME
                 , :DCLT231DSBK.DB-UPD-X )
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       I000-DELETE-T231DSHD-ENTRIES.

           MOVE 'I000' TO CA-PARAGRAPH-NBR.

           IF  DELETE-REQUESTED
               CONTINUE
           ELSE
               MOVE -1              TO M-DISTKEY-CL
               SET ERRORS           TO TRUE
               SET DELETE-REQUESTED TO TRUE
               MOVE W9999-MSG-024   TO M-MSG-22I
           END-IF.

           IF  NO-ERRORS
               PERFORM VARYING W0001-X FROM 1 BY 1
                 UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                       IF  M-ACT-CI (W0001-X) > ' '
                           SET W0001-LINES-SELECTED  TO TRUE
                           PERFORM I100-DELETE-T231DSHD-GROUP
                           PERFORM I200-DELETE-T231DSLN-GROUP
                           PERFORM I300-DELETE-T231DSBK-GROUP
                           MOVE SPACES TO M-ACT-CI (W0001-X)
                       END-IF
               END-PERFORM

               IF  W0001-LINES-SELECTED
                   MOVE -1                  TO M-DISTKEY-CL
                   MOVE W9999-MSG-014       TO M-MSG-22I
                   SET DELETE-NOT-REQUESTED TO TRUE
               ELSE
                   MOVE -1                  TO M-DISTKEY-CL
                   SET ERRORS               TO TRUE
                   MOVE W9999-MSG-025       TO M-MSG-22I
               END-IF
           END-IF.

           EJECT
       I100-DELETE-T231DSHD-GROUP.

           MOVE 'I100'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-F-DSID-C      (W0001-X)
             TO F-DSID-C           IN DCLT231DSHD.

           EXEC SQL
                DELETE FROM D231.T231DSHD
                 WHERE F_DSID_C      = :DCLT231DSHD.F-DSID-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       I200-DELETE-T231DSLN-GROUP.

           MOVE 'I200'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-F-DSID-C      (W0001-X)
             TO F-DSID-C           IN DCLT231DSHD.

           EXEC SQL
                DELETE FROM D231.T231DSLN
                 WHERE F_DSID_C      = :DCLT231DSHD.F-DSID-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       I300-DELETE-T231DSBK-GROUP.

           MOVE 'I300'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-F-DSID-C      (W0001-X)
             TO F-DSID-C           IN DCLT231DSHD.

           EXEC SQL
                DELETE FROM D231.T231DSBK
                 WHERE F_DSID_C      = :DCLT231DSHD.F-DSID-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
      **===========================================================**
      **   COPYBOOK AREA FOR CICS CONTROL AND SUB-MODULES          **
      **===========================================================**
           EXEC SQL
              INCLUDE C108Z000
           END-EXEC.

           EJECT
           COPY C108Z900.

           EJECT
           COPY C108Z998.

